home *** CD-ROM | disk | FTP | other *** search
/ MacGames Sampler / PHT MacGames Bundle.iso / MacSource Folder / Samples from the CD / Pascal / Source□ / Talk Source / Talk ƒ / OOTalk.p < prev    next >
Encoding:
Text File  |  1992-04-20  |  8.1 KB  |  374 lines  |  [TEXT/PJMM]
  1. unit OOTalk;
  2.  
  3. { This program was written by Peter N Lewis, Mar 1992 in THINK Pascal 4.0.1 }
  4.  
  5. interface
  6.  
  7.     uses
  8.         OOMainLoop, OOStaticEdit;
  9.  
  10.     type
  11.         TalkObject = object
  12.                 us: DObject;
  13.                 procedure Create (id: integer);
  14.                 procedure Destroy;  { to close the window, call this.  It will get called if the user closes it }
  15.                 procedure TransmitKey (ch: char);  { override this proc to handle sending characters down the line }
  16.                 procedure TransmitBlock (h: handle; len: longInt);
  17.                 procedure ReceiveKey (ch: char); { call this proc when you receive a key }
  18.             end;
  19.  
  20. implementation
  21.  
  22.     uses
  23.         MyTypes, MyTEUtils, BaseGlobals, MyUtilities, PrefsGlobals;
  24.  
  25.     type
  26.         TObject = object(DObject)
  27.                 te1, te2: TEStaticObject;
  28.                 t: TalkObject;
  29.                 reverse_panes: boolean;
  30.                 procedure Create (id: integer);
  31.                 override;
  32.                 procedure Destroy;
  33.                 override;
  34.                 procedure DoClose;
  35.                 override;
  36.                 procedure DoItemWhere (er: eventRecord; item: integer);
  37.                 override;
  38.                 procedure DoKey (modifiers: integer; ch: char; code: integer);
  39.                 override;
  40.                 procedure DoAutoKey (modifiers: integer; ch: char; code: integer);
  41.                 override;
  42.                 procedure DoIdle;
  43.                 override;
  44.                 procedure Resize;
  45.                 override;
  46.                 procedure DoActivateDeactivate (activate: boolean);
  47.                 override;
  48.                 function EditMenuEnabled: boolean;
  49.                 override;
  50.                 procedure SetEditMenuItem (item: integer);
  51.                 override;
  52.                 procedure DoEditMenu (item: integer);
  53.                 override;
  54.                 procedure CalculateRegion (var rgn: rgnHandle);
  55.                 override;
  56.                 procedure ReceiveKey (ch: char);
  57.                 function ActiveTE: TEStaticObject;
  58.             end;
  59.  
  60.     procedure TalkObject.Create (id: integer);
  61.         var
  62.             tempus: TObject;
  63.     begin
  64.         new(tempus);
  65.         us := tempus;
  66.         us.Create(id);
  67.         TObject(us).t := self;
  68.     end;
  69.  
  70.     procedure TalkObject.Destroy;
  71.     begin
  72.         us.Destroy;
  73.         dispose(self);
  74.     end;
  75.  
  76.     procedure TalkObject.TransmitKey (ch: char);  { override this proc to handle sending characters down the line }
  77.     begin
  78.     end;
  79.  
  80.     procedure TalkObject.TransmitBlock (h: handle; len: longInt);  { override this proc to handle sending characters down the line }
  81.     begin
  82.     end;
  83.  
  84.     procedure TalkObject.ReceiveKey (ch: char); { call this proc when you receive a key }
  85.     begin
  86.         TObject(us).ReceiveKey(ch);
  87.     end;
  88.  
  89.     function TObject.ActiveTE: TEStaticObject;
  90.     begin
  91.         if te1.te^^.selStart < te1.te^^.selEnd then
  92.             ActiveTE := te1
  93.         else if te2.te^^.selStart < te2.te^^.selEnd then
  94.             ActiveTE := te2
  95.         else
  96.             ActiveTE := te1;
  97.     end;
  98.  
  99.     function FindTEObject (dlg: dialogPtr; item: integer): TEStaticObject;
  100.         var
  101.             t: TObject;
  102.     begin
  103.         FindTEObject := nil;
  104.         t := TObject(GetWObject(dlg));
  105.         if t.te1 <> nil then
  106.             if t.te1.titem = item then
  107.                 FindTEObject := t.te1;
  108.         if t.te2 <> nil then
  109.             if t.te2.titem = item then
  110.                 FindTEObject := t.te2;
  111.     end;
  112.  
  113.     procedure DrawTEObject (dlg: dialogPtr; item: integer);
  114.         var
  115.             teo: TEStaticObject;
  116.     begin
  117.         FindTEObject(dlg, item).Draw;
  118.     end;
  119.  
  120.     function TObject.EditMenuEnabled: boolean;
  121.         var
  122.             dummy: boolean;
  123.     begin
  124.         dummy := ActiveTE.EditMenuEnabled;
  125.         if ActiveTE = te1 then
  126.             TESetEditMenuItem(te1.te, false, 32000, EMpaste);
  127.         EditMenuEnabled := GetMHandle(M_Edit)^^.enableFlags <> 0;
  128.     end;
  129.  
  130.     procedure TObject.SetEditMenuItem (item: integer);
  131.     begin
  132.         if (item = EMpaste) and (ActiveTE = te1) then begin
  133.             TESetEditMenuItem(te1.te, false, 32000, EMpaste);
  134.         end
  135.         else
  136.             ActiveTE.SetEditMenuItem(item)
  137.     end;
  138.  
  139.     procedure TObject.DoEditMenu (item: integer);
  140.         var
  141.             h: handle;
  142.             len, i: longInt;
  143.             oe: OSErr;
  144.     begin
  145.         if item = EMpaste then begin
  146.             oe := TEFromScrap;
  147.             len := TEGetScrapLen;
  148.             if len > 2000 then begin
  149.                 len := 2000;
  150.                 TESetScrapLen(len);
  151.             end;
  152.             t.TransmitBlock(TEScrapHandle, len);
  153.             TESetSelect(maxLongInt, maxLongInt, te1.te);
  154.             TEPaste(te1.te);
  155.         end
  156.         else
  157.             ActiveTE.DoEditMenu(item);
  158.     end;
  159.  
  160.     procedure TObject.DoKey (modifiers: integer; ch: char; code: integer);
  161.         procedure SendChar (ch: char);
  162.         begin
  163.             TESetSelect(maxlongint, maxlongint, te1.te);
  164.             TEDeactivate(te2.te);
  165.             if is_active then
  166.                 TEActivate(te1.te);
  167.             te1.DoKey(modifiers, ch);
  168.             t.TransmitKey(ch);
  169.         end;
  170.         var
  171.             charpos: integer;
  172.     begin
  173.         with te1.te^^ do begin
  174.             if BAND(modifiers, cmdKey) = 0 then begin
  175.                 case ch of
  176.                     enter, cr:  begin
  177.                         ch := cr;
  178.                     end;
  179.                     del, bs:  begin
  180.                         if prefs.no_return_delete & (teLength > 0) & (ptr(ord(hText^) + teLength - 1)^ = ord(cr)) then
  181.                             ch := nul
  182.                         else
  183.                             ch := bs;
  184.                     end;
  185.                     tab, spc:  begin
  186.                         ch := spc;
  187.                     end;
  188.                     otherwise
  189.                         if ch < spc then
  190.                             ch := nul;
  191.                 end;
  192.                 charpos := 0;
  193.                 while (charpos < teLength) & (ptr(ord(hText^) + teLength - charpos - 1)^ <> ord(cr)) do
  194.                     charpos := charpos + 1;
  195.             end;
  196.             if ch <> nul then begin
  197.                 if (charpos > 70) & (ch = spc) then
  198.                     ch := cr;
  199.                 if prefs.no_return_delete & (charpos > 78) & (ch <> cr) & (ch <> bs) then
  200.                     SendChar(cr);
  201.                 SendChar(ch);
  202.             end;
  203.         end;
  204.     end;
  205.  
  206.     procedure TObject.ReceiveKey (ch: char);
  207.     begin
  208.         case ch of
  209.             enter, lf, cr: 
  210.                 ch := cr;
  211.             del, bs: 
  212.                 ch := bs;
  213.             tab: 
  214.                 ch := spc;
  215.             otherwise
  216.                 if ch < spc then
  217.                     ch := nul;
  218.         end;
  219.         if ch <> nul then begin
  220.             TEDeactivate(te2.te);
  221.             if is_active then
  222.                 TEActivate(te1.te);
  223.             TESetSelect(maxlongint, maxlongint, te2.te);
  224.             te2.DoKey(0, ch);
  225.         end;
  226.     end;
  227.  
  228.     procedure TObject.DoAutoKey (modifiers: integer; ch: char; code: integer);
  229.     begin
  230.         DoKey(modifiers, ch, code);
  231.     end;
  232.  
  233.     procedure TObject.DoIdle;
  234.     begin
  235.         te1.DoIdle;
  236.     end;
  237.  
  238.     procedure TObject.DoActivateDeactivate (activate: boolean);
  239.         var
  240.             teo: TEStaticObject;
  241.     begin
  242.         inherited DoActivateDeactivate(activate);
  243.         if is_active then begin
  244.             teo := ActiveTE;
  245.             TEActivate(teo.te);
  246.         end
  247.         else begin
  248.             TEDeactivate(te1.te);
  249.             TEDeactivate(te2.te);
  250.         end;
  251.     end;
  252.  
  253.     procedure TObject.DoItemWhere (er: eventRecord; item: integer);
  254.         var
  255.             teo, teox: TEStaticObject;
  256.     begin
  257.         teo := FindTEObject(window, item);
  258.         if teo = nil then
  259.             DoItem(item)
  260.         else begin
  261.             if teo = te1 then
  262.                 teox := te2
  263.             else
  264.                 teox := te1;
  265.             TEAutoView(false, teox.te);
  266.             TESetSelect(maxlongint, maxlongint, teox.te);
  267.             TEDeactivate(teox.te);
  268.             TEAutoView(true, teox.te);
  269.             if is_active then
  270.                 TEActivate(teo.te);
  271.             teo.DoItemWhere(er, item);
  272.             if ActiveTE <> teo then begin
  273.                 TEDeactivate(teo.te);
  274.                 if is_active then
  275.                     TEActivate(teox.te);
  276.             end;
  277.         end;
  278.     end;
  279.  
  280.     procedure TObject.Create (id: integer);
  281.         var
  282.             k: integer;
  283.             h: handle;
  284.             r: rect;
  285.             tempte: TEStaticObject;
  286.             lw: integer;
  287.     begin
  288.         inherited Create(id);
  289.         reverse_panes := prefs.type_in_bottom_pane;
  290.         draw_grow_icon := true;
  291.         is_active := in_foreground;
  292.         SetPort(window);
  293.         TextFont(monaco);
  294.         TextSize(9);
  295.         new(tempte);
  296.         te1 := tempte;
  297.         lw := CharWidth('a') * 80;
  298.         te1.Create(window, 1, lw, true, true, reverse_panes, reverse_panes);
  299.         GetDItem(window, 1, k, h, r);
  300.         SetDItem(window, 1, k, handle(@DrawTEObject), r);
  301.         new(tempte);
  302.         te2 := tempte;
  303.         te2.Create(window, 2, lw, true, true, not reverse_panes, not reverse_panes);
  304.         GetDItem(window, 2, k, h, r);
  305.         SetDItem(window, 2, k, handle(@DrawTEObject), r);
  306.         Resize;
  307.     end;
  308.  
  309.     procedure TObject.Destroy;
  310.     begin
  311.         te1.Destroy;
  312.         te2.Destroy;
  313.         inherited Destroy;
  314.     end;
  315.  
  316.     procedure TObject.DoClose;
  317.     begin
  318.         t.Destroy;
  319.     end;
  320.  
  321.     procedure TObject.Resize;
  322.         var
  323.             k: integer;
  324.             h: handle;
  325.             r1, r2, r: rect;
  326.     begin
  327.         with window^.portrect do begin
  328.             SetRect(r1, -1, -1, right + 1, bottom div 2);
  329.             SetRect(r2, -1, bottom div 2, right + 1, bottom + 1);
  330.         end;
  331.         if reverse_panes then begin
  332.             r := r1;
  333.             r1 := r2;
  334.             r2 := r;
  335.         end;
  336.         GetDItem(window, 1, k, h, r);
  337.         SetDItem(window, 1, k, h, r1);
  338.         te1.Resize;
  339.         GetDItem(window, 2, k, h, r);
  340.         SetDItem(window, 2, k, h, r2);
  341.         te2.Resize;
  342.         inherited Resize;
  343.     end;
  344.  
  345.     procedure TObject.CalculateRegion (var rgn: rgnHandle);
  346.         var
  347.             pt: point;
  348.             rgn2: rgnHandle;
  349.             r: rect;
  350.     begin
  351.         SetPort(window);
  352.         GetMouse(pt);
  353.  
  354.         rgn := NewRgn;
  355.         r := te1.te^^.viewRect;
  356.         RectRgn(rgn, r);
  357.  
  358.         rgn2 := NewRgn;
  359.         r := te2.te^^.viewRect;
  360.         RectRgn(rgn2, r);
  361.  
  362.         UnionRgn(rgn, rgn2, rgn);
  363.         if PtInRgn(pt, rgn) then begin
  364.             SetCursor(GetCursor(iBeamCursor)^^);
  365.         end
  366.         else begin
  367.             SetCursor(arrow);
  368.             SetRectRgn(rgn2, -30000, -30000, 30000, 30000);
  369.             DiffRgn(rgn2, rgn, rgn);
  370.         end;
  371.         DisposeRgn(rgn2);
  372.     end;
  373.  
  374. end.